Monster Media 1996 #15/Monster Media Number 15 (Monster Media)(July 1996).ISO/os2/lxlt113.zip/SOURCES/UNLOCK.PAS

Pascal/Delphi Source File | 1996-05-07 | 5.0 KB | 200 lines

uses  os2base, miscUtil, Helpers, strOp, Crt, Dos;
const Version   = '1.0.1';
      Recurse   : boolean = _OFF;
      Pause     : boolean = _OFF;
      Verbose   : boolean = _ON;

var   OldExit   : Procedure;
      fNames    : pDarray;
      allDone   : boolean;

Procedure Stop(eCode : Byte);
begin
 case eCode of
  1,2 : begin
         if eCode = 2
          then begin
                TextAttr := $0C;
                Writeln('├ Invalid switch - see help below for details');
               end;
         TextAttr := $07;
         Writeln('├ Usage: unLock [FileMask1] {...FileMask2} {/EPVH?}');
         Writeln('├ /E{+|-} r[E]cursive (+) file search through subdirectories');
         Writeln('├ /P{+|-} Enable (+) or disable (-) pause before each file');
         Writeln('├ /V{+|-} Verbose (show a lot of additional information)');
         Writeln('├ /?,/H   Show this help screen');
         Writeln('├┤Default: /E- /P- /V+');
         TextAttr := $08;
         Writeln('└┤Example: unLock d:\*.exe d:\*.dll /e');
        end;
 end;
 Halt(eCode);
end;

Function ParmHandler(var S : string) : Byte;
var I : Longint;

Function Enabled : boolean;
begin
 Enabled := _ON;
 if length(S) = 1
  then exit
  else
 if (S[2] in ['+','-'])
  then ParmHandler := 2
  else
 if (S[2] in [' ','/'])
  then exit
  else Stop(2);
 if S[2] = '-' then Enabled := _OFF;
end;

begin
 ParmHandler := 1;
 case upCase(S[1]) of
  '?',
  'H' : Stop(1);
  'E' : Recurse := Enabled;
  'P' : Pause := Enabled;
  'V' : Verbose := Enabled;
  else Stop(2);
 end;
end;

Function NameHandler(var S : string) : Byte;
var I     : Longint;
    Quote : boolean;
begin
 I := 0;
 if S[1] = '"' then begin Quote := _ON; Delete(S, 1, 1); end else Quote := _OFF;
 While (I < length(S)) and ((S[succ(I)] > ' ') or Quote) do
  if Quote and (S[succ(I)] = '"')
   then break
   else Inc(I);
 fNames^.AddItem(NewStr(Copy(S, 1, I)));
 Inc(I, byte(Quote));
 NameHandler := I;
end;

Procedure MyExitProc;
begin
 Write(#13);
 TextAttr := $07; ClrEOL;
 OldExit;
end;

Function Ask(const Q,A : string) : byte;
var ch  : char;
begin
 TextAttr := $02;
 Write('└ ', Q, ' ');
 repeat
  ch := upCase(ReadKey);
  if First(ch, A) <> 0
   then begin
         Ask := First(ch, A);
         break;
        end;
 until _OFF;
 Writeln(Ch,#13'├');
end;

Procedure ProcessFile(fName : string);
var   _d    : DirStr;
      _n    : NameStr;
      _e    : ExtStr;
      F     : File;

Procedure NotLocked;
begin
 if Verbose
  then begin Write(' not locked'); textAttr := $0B; Writeln(#13'├'); end
  else begin Write(#13); ClrEOL; end;
end;

begin
 if length(fName) >= 255 then exit;
 fSplit(fName, _d, _n, _e);
 textAttr := $0B; ClrEOL; Write('└ Processing file ', Copy(_n + _e, 1, 28));
 FileMode := open_share_DenyReadWrite or open_access_ReadOnly;
 Assign(F, fName); Reset(F, 1);
 if ioResult = 0
  then begin
        Close(F); NotLocked;
        Exit;
       end;
 fName[succ(length(fName))] := #0; Inc(byte(fName[0]));
 case DosReplaceModule(@fName[1], nil, nil) of
  0 : begin
       textAttr := $0A; Write(' unlocked');
       textAttr := $0B; Writeln(#13'├');
      end;
  2 : NotLocked;
 else begin
       textAttr := $0C; Write(' sharing violation');
       textAttr := $0B; Writeln(#13'├');
      end
 end;
end;

Procedure ProcessFiles(const fN : string; Level : Longint);
var sr : SearchRec;
    _d : DirStr;
    _n : NameStr;
    _e : ExtStr;
    nf : Longint;
begin
 fSplit(fN, _d, _n, _e);
 FindFirst(fN, Archive or Hidden or SysFile, sr);
 if (DosError <> 0) and (Level = 0) and (not Recurse)
  then begin
        textAttr := $0C;
        Writeln('├ Cannot find such files: ', fN);
       end;
 nf := 0;
 While (DosError = 0) and (not allDone) do
  begin
   if Pause
    then case Ask('File ' + sr.Name + ': [P]rocess, [S]kip or [A]bort?', 'PSA') of
          2 : sr.Name := '';
          3 : begin allDone := _ON; break; end;
         end;
   if (sr.Name <> '') then ProcessFile(_d + sr.Name);
   FindNext(sr);
  end;
 FindClose(sr);
 if allDone or not Recurse then Exit;
 if nf = 0 then begin textAttr := $0B; Write('└ ', _d); ClrEOL; Write(#13); end;
 FindFirst(_d + '*.*', Archive or Hidden or SysFile or Directory, sr);
 While (dosError = 0) and (not allDone) do
  begin
   if (sr.Attr and Directory <> 0) and (sr.Name[1] <> '.')
    then ProcessFiles(_d + sr.Name + '\' + _n + _e, succ(Level));
   FindNext(sr);
  end;
 FindClose(sr);
end;

var I : Longint;

begin
 TextAttr := $0F;
 Writeln('┌[ unLock ]──────────────────────────────[ Version '+Version+' ]┐');
 Writeln('├ Copyright 1996 by FRIENDS software ─ No rights reserved ┘');
 TextAttr := $07;
 @OldExit := ExitProc; ExitProc := @MyExitProc;
 New(fNames, Init(8));
 ParseCommandLine(#1, ParmHandler, NameHandler);
 if (fNames^.numItems = 0) then Stop(1);

 For I := 1 to fNames^.numItems do
  begin
   ProcessFiles(pString(fNames^.GetItem(I))^, 0);
   if allDone then break;
  end;

 TextAttr := $01; ClrEOL;
 Writeln('└┤Done');
end.